home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / TCUNIT / WINDINST.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-02  |  2KB  |  58 lines
  1. (*
  2.  *    PROGRAM : WindTest installation example
  3.  *    SYSTEM  : Turbo Pascal 4.0, 5.0, and 5.5
  4.  *    AUTHOR  : (C) 1988, 1989 by Tom Swan
  5.  *)
  6.  
  7. PROGRAM WindInst;
  8.  
  9.  
  10. USES  Crt, TCUnit, WindGlob;
  11.  
  12. CONST FileName = 'WINDTEST.EXE';    { File to modify }
  13.  
  14. VAR   userQuits : Boolean;          { True to end program }
  15.  
  16.  
  17. FUNCTION MenuChar : Char;
  18.  
  19. { Display menu and return selection }
  20.  
  21. BEGIN
  22.    ClrScr;
  23.    Writeln( 'WindTest Installation Program' );
  24.    Writeln( '--------------------------------------------' );
  25.    Writeln( 'A - Border foreground ...... ', WBForeColor:2 );
  26.    Writeln( 'B - Border background ...... ', WBBackColor:2 );
  27.    Writeln( 'C - Text foreground ........ ', WTForeColor:2 );
  28.    Writeln( 'D - Text background ........ ', WTBackColor:2 );
  29.    Writeln( 'E - Window title ........... ', WTitle );
  30.    Writeln;
  31.    Writeln( 'Q - Quit and save changes' );
  32.    Writeln( 'X - Quit and do NOT save changes' );
  33.    Writeln;
  34.    Write(   'Pick a letter, any letter: ' );
  35.    MenuChar := UpCase( ReadKey )
  36. END; { MenuChar }
  37.  
  38.  
  39. {$V-}    { Turn off string-parameter length checking }
  40.  
  41. BEGIN
  42.    userQuits := False;
  43.    REPEAT
  44.       CASE MenuChar OF
  45.          'A' : GetWord( 'Border foreground', WBForeColor, 0, 15 );
  46.          'B' : GetWord( 'Border background', WBBackColor, 0, 15 );
  47.          'C' : GetWord( 'Text foreground', WTForeColor, 0, 15 );
  48.          'D' : GetWord( 'Text background', WTBackColor, 0, 15 );
  49.          'E' : GetStr( 'Window title', WTitle, 40 );
  50.          'Q' : userQuits := ChangesSaved( fileName, CBase, 
  51.                               Ofs( CBase ), Ofs( EBase ) );
  52.          'X' : userQuits := True
  53.       END { case }
  54.    UNTIL userQuits;
  55.    GotoXY( 1, 25 )
  56. END.
  57.  
  58.